unit CandleStick;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Contnrs, Graphics, Types;

type
  TTipoGrafico = (grafCandle, grafBarra, grafLinha);
  TPeriodoGraf = (per1D,per5D,per1M,per2M,per3M,per6M,per1A,per2A);

  TDado = class
  private
    FMaximo: Currency;
    FAbertura: Currency;
    FEncerramento: Currency;
    FMinimo: Currency;
    FData: TDateTime;
  public
    property Data: TDateTime read FData write FData;
    property Abertura: Currency read FAbertura write FAbertura;
    property Maximo: Currency read FMaximo write FMaximo;
    property Minimo: Currency read FMinimo write FMinimo;
    property Encerramento: Currency read FEncerramento write FEncerramento;
  end;

  TDadoList = class(TObjectList)
  private
    function GetItem(Index: Integer): TDado;
    procedure SetItem(Index: Integer; const Value: TDado);
  public
    function New: TDado;
    property Items[Index: Integer]: TDado read GetItem write SetItem;
  end;

  TCandleStick = class(TGraphicControl)
  private
    minY,maxY: Currency;
    FDados: TDadoList;
    FTipoGrafico: TTipoGrafico;
    FlinhasX: Byte;
    FlinhasY: Byte;
    FMargemX: Byte;
    FMargemY: Byte;
    FPeriodo: TPeriodoGraf;
    FMMA: Word;
    FMME: Word;
    procedure plotarEscala;
    procedure plotarGrafLinha(d: TDadoList);
    function getX(value,QtdeDados: Integer): integer;
    function getY(value: currency): integer;
    procedure plotarGrafBarra(d: TDadoList);
    procedure plotarGrafCandle(d: TDadoList);
    procedure getDados(var d: TDadoList);
    function getQtdeDados: word;
    procedure gerarMMA;
    procedure gerarMME;
  protected

  public
    procedure add(Abertura,Maximo,Minimo,Encerramento: Currency; Data: TDateTime);
    procedure clear;
    procedure plotarGrafico;
    property Dados: TDadoList read FDados write FDados;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property TipoGrafico: TTipoGrafico read FTipoGrafico write FTipoGrafico;
    property linhasX: Byte read FlinhasX write FlinhasX default 8;
    property linhasY: Byte read FlinhasY write FlinhasY default 8;
    property MargemX: Byte read FMargemX write FMargemX default 15;
    property MargemY: Byte read FMargemY write FMargemY default 15;
    property Periodo: TPeriodoGraf read FPeriodo write FPeriodo;
    property MMA: Word read FMMA write FMMA;
    property MME: Word read FMME write FMME;
    property align;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComp', [TCandleStick]);
end;

{ TCandleList }

function TDadoList.GetItem(Index: Integer): TDado;
begin
  Result := TDado(Inherited Items[Index]);
end;

function TDadoList.New: TDado;
begin
  Result := TDado.Create;
  Add(Result);
end;

procedure TDadoList.SetItem(Index: Integer; const Value: TDado);
begin
  Put(Index, Value);
end;


{ TCandleStick }

procedure TCandleStick.add(abertura, maximo, minimo, encerramento: Currency; Data: TDateTime);
var c: TDado;
begin
  c := TDado.Create;
  c.Data := Data;
  c.Abertura := Abertura;
  c.Maximo := Maximo;
  c.Minimo := Minimo;
  c.Encerramento := Encerramento;

  Dados.Add(c);
end;

procedure TCandleStick.clear;
begin
  FDados.Clear;
end;

constructor TCandleStick.Create(AOwner: TComponent);
begin
  inherited;

  linhasX := 8;
  linhasY := 8;
  MargemX := 15;
  MargemY := 15;
  Dados := TDadoList.Create;
  Clear;
end;

destructor TCandleStick.Destroy;
begin
  Dados.Free;

  inherited;
end;

procedure TCandleStick.plotarEscala;
var h,w,i,a: Integer;
begin
  h := (Height- 1);
  w := (Width - 1);

  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clWhite;
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Rect(0,0,Width,Height)); //abertura e encerramento

  //desenhar o contorno
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clBlack;
  Canvas.Polyline([Point(0,0),Point(w,0),Point(w,h),Point(0,h),Point(0,0)]);

  //desenhar as linhas horizontais
  for i  := 1 to (linhasX-1) do begin
    Canvas.Pen.Style := psDot;
    a := Trunc(h/linhasX*i);
    Canvas.Polyline([Point(0,a), Point(w,a)]);
  end;

  //desenhar as linhas verticais
  for i  := 1 to (linhasY-1) do begin
    Canvas.Pen.Style := psDot;
    a := Trunc(w/linhasY*i);
    Canvas.Polyline([Point(a,0), Point(a,w)]);
  end;
end;

function TCandleStick.getX(value,QtdeDados: Integer): integer;
var EscX: Currency;
begin
  EscX := (Width - (MargemX*2)) / QtdeDados;
  Result := Trunc((value) * EscX) + MargemX;
end;

function TCandleStick.getY(value: currency): integer;
var EscY: Currency;
begin
  EscY := (Height - (MargemY*2)) / (MaxY - MinY);
  Result := Trunc((MaxY - value) * EscY) + MargemY;
end;

procedure TCandleStick.Paint;
begin
  inherited;
  plotarGrafico;
end;

function TCandleStick.getQtdeDados: word;
begin
  case Periodo of
    //per1D: ;
    //per5D: ;
    per1M: result := 30;
    per2M: result := 60;
    per3M: result := 90;
    per6M: result := 120;
    per1A: result := 360;
    per2A: result := 720;
  end;
end;

procedure TCandleStick.getDados(var d: TDadoList);
var I, p: Integer;
    G: TDado;
begin

  maxY := 0;
  minY := 1000;

  p := (FDados.Count - getQtdeDados);
  if (p < 0) then p := 0;

  for I := p to (FDados.Count - 1) do begin
    g := TDado(FDados[i]);
    d.add(g);
    //verificar os limites
    if (g.Maximo > maxY) then maxY := g.Maximo;
    if (g.Minimo < minY) then minY := g.Minimo;
  end;
end;

procedure TCandleStick.plotarGrafico;
var d: TDadoList;
begin
  try
    d := TDadoList.Create(False);
    getDados(d);
    plotarEscala;

    case FTipoGrafico of
      grafCandle: plotarGrafCandle(d);
      grafBarra: plotarGrafBarra(d);
      grafLinha: plotarGrafLinha(d);
    end;

    if FMMA > 0 then gerarMMA;
    if FMME > 0 then gerarMME;    
  finally
    d.Free;
  end;
end;

procedure TCandleStick.plotarGrafLinha(d: TDadoList);
var i,tam: Integer;
    g: TDado;
    a: array of TPoint;
begin
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;

  for I := 0 to (d.Count - 1) do begin
    g := TDado(d[i]);
    tam := Length(a);
    SetLength(a,tam+1);
    a[tam] := Point(getX(i, d.Count), getY(g.FEncerramento));
  end;

  Canvas.Polyline(a);
end;

procedure TCandleStick.plotarGrafBarra(d: TDadoList);
var i,x,y1,y2,y3,y4: Integer;
    g: TDado;
begin
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;

  for I := 0 to (d.Count - 1) do begin
    g := TDado(d[i]);

    x := getX(i, d.Count);
    y1 := getY(g.FMinimo);
    y2 := getY(g.FMaximo);
    y3 := getY(g.FAbertura);
    y4 := getY(g.FEncerramento);

    if (g.FAbertura > g.FEncerramento) then Canvas.Pen.Color := clRed
    else Canvas.Pen.Color := clGreen;

    Canvas.Polyline([Point(x,y1),Point(x,y2)]); //maximo e minimo
    Canvas.Polyline([Point(x,y3),Point(x-5,y3)]); //abertura p/ esquerda
    Canvas.Polyline([Point(x,y4),Point(x+5,y4)]); //enceramento p/ direita
  end;
end;

procedure TCandleStick.plotarGrafCandle(d: TDadoList);
var i,x,y1,y2,y3,y4: Integer;
    g: TDado;
begin
  Canvas.Pen.Style := psSolid;

  for I := 0 to (d.Count - 1) do begin
    g := TDado(d[i]);

    x := getX(i, d.Count);
    y1 := getY(g.FMinimo);
    y2 := getY(g.FMaximo);
    y3 := getY(g.FAbertura);
    y4 := getY(g.FEncerramento);

    if (g.Abertura > g.Encerramento) then begin
      Canvas.Brush.Color := clRed;
      Canvas.Pen.Color := clRed;
      Canvas.Polyline([Point(x,y1),Point(x,y2)]); //maximo e minimo
      Canvas.FillRect(Rect(x-5,y3,x+5,y4)); //abertura e encerramento
    end else begin
      Canvas.Brush.Color := clGreen;
      Canvas.Pen.Color := clGreen;
      Canvas.Polyline([Point(x,y1),Point(x,y2)]); //maximo e minimo
      Canvas.FillRect(Rect(x-5,y3,x+5,y4)); //abertura e encerramento
      Canvas.Polyline([Point(x-5,y3),Point(x+5,y3),Point(x+5,y4),Point(x-5,y4),Point(x-5,y3)]); //abertura e encerramento
    end;
  end;
end;

function getMediaAritmetica(a: array of  Currency): Currency;
var i: Integer;
    s: Currency;
begin
  s := 0;
  for I := Low(a) to High(a) do begin
    s := s + a[i];
  end;
  i := Length(a);
  Result := (s / i);
end;

procedure TCandleStick.gerarMMA;
var i,j,p,tam: Integer;
    d: TDado;
    a: array of TPoint;
    l: array of Currency;
    media: Currency;
begin
  j := 0;
  SetLength(l,FMMA); //armazena os ultimos (n-1) elementos para media

  p := (FDados.Count - getQtdeDados - FMMA);
  if (p < 0) then p := 0;

  for I := p to (Dados.Count - 1) do begin
    d := TDado(Dados[i]);

    l[j] := d.Encerramento;
    Inc(j);
    if (j >= FMMA) then j := 0;

    if (i >= (p+FMMA)) then begin
      media := getMediaAritmetica(l);
      tam := Length(a);
      SetLength(a, tam+1);
      a[tam] := Point(getX(tam,getQtdeDados), getY(media));
    end;
  end;

  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clGreen;
  Canvas.Polyline(a);
end;

procedure TCandleStick.gerarMME;
var i,p,tam: Integer;
    d: TDado;
    a: array of TPoint;
    k,media: Currency;
begin
  k := 2 / (FMME + 1);
  media := 0;

  p := (FDados.Count - getQtdeDados - FMME);
  if (p < 0) then p := 0;

  for I := p to (Dados.Count - 1) do begin
    d := TDado(Dados[i]);
    media := (d.Encerramento * k) + media * (1-K);
    if (i >= (p+FMME)) then begin
      tam := Length(a);
      SetLength(a,tam+1);
      a[tam] := Point(getX(tam,getQtdeDados), getY(media));
    end;
  end;

  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clBlue;
  Canvas.Polyline(a);
end;

end.
